﻿// Lexer.fs
//
// Copyright 2009 Sergey Mechtaev
//
// This program is free software; you can redistribute it and/or
// modify it under the terms of the GNU General Public License
// as published by the Free Software Foundation.


#light

namespace SmartCPP.Core.Parser

open GlobalLexer
open GlobalTokens
open DirectiveLexer
open DirectiveTokens
open System.IO
open System.Text

module Lexer =

    ///Serment of start*length
    type Segment = int*int
    
    
    ///Text with position
    type StringWithPosition = string*Segment    
    
    ///Conditional directive argument
    ///Macro name or expression
    type IfDirExpr =
        | MacroId of StringWithPosition
        | Expression of StringWithPosition
    
    ///Arguments of define directive
    ///macro name * macro arguments list * macro value with their positions and directive position
    type DefineArgumentType = (StringWithPosition * StringWithPosition list * StringWithPosition) * Segment
    
    ///File name with position and directive position
    type IncludeDirectiveType = StringWithPosition * Segment
    
    ///Directive argument with position and directive position
    type IfDirectiveType = IfDirExpr * Segment
    
    //Directive without parameters
    type NotParametrizedDirectiveType = Segment
    
    /// Text represents text between directives and global position
    /// Define - define directive with MacroName of string * ArgumentList of string list * Text of string and theirs global positions
    /// If - if directive with parameter and global position
    /// Else - else directive and global position
    /// Ifdef - ifdef directive with MacroName and global position
    /// Endif - endif directive and global position
    /// Elif - elif directive with expression represented by string
    /// Include - include directive with FileName and global position
    type Tokens =
        | Text of StringWithPosition
        | Define of DefineArgumentType
        | If of IfDirectiveType
        | Else of NotParametrizedDirectiveType
        | Ifdef of IfDirectiveType
        | Endif of NotParametrizedDirectiveType
        | Elif of IfDirectiveType
        | Include of IncludeDirectiveType
        | Eof
        
    ///Get the next lexeme in lexbuf
    let token (lexbuf : Text.Lexing.LexBuffer<char>) =
    
        let globLex = GlobalLexer.token lexbuf
        let globLex_start = lexbuf.StartPos.AbsoluteOffset
        let globLex_end = lexbuf.EndPos.AbsoluteOffset
        
        let globLex_seg dir_offset = (globLex_start-dir_offset, globLex_end-globLex_start+dir_offset)  
        
        
        ///Get if directive with its position
        ///offset+str_offset - srt start position
        ///offset - directive start position 
        let parseIf str offset str_offset =
            let ifLexbuf = Microsoft.FSharp.Text.Lexing.LexBuffer<_>.FromChars str
            let id = DirectiveLexer.ifToken ifLexbuf
            let id_seg = (offset+str_offset+ifLexbuf.StartPos.AbsoluteOffset, ifLexbuf.EndPos.AbsoluteOffset-ifLexbuf.StartPos.AbsoluteOffset)
            let dir_seg = (offset, ifLexbuf.EndPos.AbsoluteOffset-ifLexbuf.StartPos.AbsoluteOffset+str_offset)
            match id with
                | DirectiveId "defined" -> 
                    let name = DirectiveLexer.ifToken ifLexbuf
                    match name with
                        | DirectiveId Id -> (MacroId (Id, id_seg), dir_seg)
                        | _ -> failwith "incorrect if directive"
                | DirectiveLBracket _
                | DirectiveRBracket _
                | DirectiveSign _
                | DirectiveNumber _ -> (Expression ("Expression", id_seg), dir_seg) //todo expression
                | _ -> failwith "incorrect if directive"
                
        let lex =
            match globLex with
                | GlobalText s -> Text (s,(globLex_start, globLex_end-globLex_start))
                | GlobalDefineDirective s ->
                    let defineLexbuf = Text.Lexing.LexBuffer<_>.FromChars (s.ToCharArray())
                    let macroId = DirectiveLexer.defineToken defineLexbuf
                    let macroId_start = globLex_start+defineLexbuf.StartPos.AbsoluteOffset
                    let macroId_end = globLex_start+defineLexbuf.EndPos.AbsoluteOffset
                    match macroId with
                        | DirectiveMacroId mId ->
                            let parseText lexbuf offset =
                                let rec parse stringAndPositionList =
                                    let lexeme = DirectiveLexer.textToken lexbuf
                                    let lexeme_start = offset + lexbuf.StartPos.AbsoluteOffset
                                    let lexeme_end = offset + lexbuf.EndPos.AbsoluteOffset
                                    let seg = lexeme_start, lexeme_end-lexeme_start
                                    match lexeme with
                                        | DirectiveText s -> parse ((s,seg) :: stringAndPositionList)
                                        | DirectiveEof -> stringAndPositionList
                                        | _ -> failwith "directive text error"
                                let res = List.rev (parse [])
                                List.fold (fun s1 s2 -> ((fst s1)+" "+(fst s2), (fst (snd s1), (snd (snd s1))+(snd (snd s2))+1))) (List.head res) (List.tail res)
                            let IdLexbuf = Text.Lexing.LexBuffer<_>.FromChars (mId.ToCharArray())
                            let name = DirectiveLexer.macroToken IdLexbuf
                            let name_seg = (macroId_start+IdLexbuf.StartPos.AbsoluteOffset,IdLexbuf.EndPos.AbsoluteOffset-IdLexbuf.StartPos.AbsoluteOffset )
                            match name with
                                | DirectiveId id ->
                                    let args = DirectiveLexer.macroToken IdLexbuf
                                    match args with
                                        | DirectiveEof -> Define (((id, name_seg), [], parseText defineLexbuf globLex_start), globLex_seg GlobalTokens.DefineOffset)
                                        | DirectiveLBracket '(' ->
                                            let rec parseArgs args =
                                                let tok = DirectiveLexer.macroToken IdLexbuf
                                                let tok_seg = (macroId_start+IdLexbuf.StartPos.AbsoluteOffset,IdLexbuf.EndPos.AbsoluteOffset-IdLexbuf.StartPos.AbsoluteOffset )
                                                match tok with
                                                    | DirectiveId id -> parseArgs ((id, tok_seg) :: args)
                                                    | DirectiveComma -> parseArgs args 
                                                    | DirectiveRBracket ')' -> args
                                                    | _ -> failwith "incorrect marco arguments"
                                            Define (((id, name_seg), List.rev (parseArgs []), parseText defineLexbuf globLex_start), globLex_seg GlobalTokens.DefineOffset)
                                        | _ -> failwith "incorrect define directive"
                                | _ -> failwith "incorrect define directive"
                        | _ -> failwith "incorrect define directive"
                | GlobalIfDirective s -> If (parseIf (s.ToCharArray()) globLex_start GlobalTokens.IfOffset)
                | GlobalElseDirective -> Else (globLex_seg 0)
                | GlobalIfdefDirective s ->
                    let ifLexbuf = Text.Lexing.LexBuffer<_>.FromChars (s.ToCharArray())
                    let id = DirectiveLexer.macroToken ifLexbuf
                    let id_seg = (globLex_start+ifLexbuf.StartPos.AbsoluteOffset, ifLexbuf.EndPos.AbsoluteOffset-ifLexbuf.StartPos.AbsoluteOffset)
                    match id with
                        | DirectiveId Id -> Ifdef ((MacroId (Id,id_seg)), globLex_seg GlobalTokens.IfOffset)
                        | _ -> failwith "incorrect if directive"
                | GlobalElifDirective s -> Elif (parseIf (s.ToCharArray()) globLex_start GlobalTokens.ElifOffset)
                | GlobalEndifDirective -> Endif (globLex_seg 0)
                | GlobalIncludeDirective s -> Include ((s, (globLex_start, globLex_end-globLex_start) ), globLex_seg GlobalTokens.IncludeOffset)
                | GlobalEof -> Eof 
        lex
             